00100		TITLE HOMNEW
00200		ENTRY HOMNEW
00300		EXTERNAL .COMM.,POSI,PTR,XRN,STF,AMOD,FINDIT,ALF,PLACE
00400		MM←1 ↔ NN←2  
00500	JK←3 ↔JT←4 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
00600	RC←14 ↔ NX←15	;**** AC'S 0,1,2,3,5  ARE USED IN 'PLACE' & 'FINDIT'!!
00700	;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
00800	;;	SUBROUTINE HOMER
00900	;;	IMPLICIT INTEGER(A-Q,S-Z)
01000	;;	REAL PWDS,DISX,A,B,PLACE,STFF
01100	;;	COMMON /STF/RSTFAC(-3/4),RSTJ2
01200	;;    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
01300	;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
01400	;;	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
01500	;;	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(JT,JQ(9)),(RD,RN(4000))
01600	;;	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
01700	;;	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
01800	
01900		DEFINE FIXX(N)
02000	<	JUMPGE	N,.+5
02100		MOVNS	N
02200		FIX 	N,233000    
02300		MOVNS	N
02400		CAIA
02500		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
02600	HOMNEW:	0		; IF(JA.EQ.6)GO TO 9
02700		SETOM ALF+1	; FLAG FOR DIFF. STAVES
02800		MOVE	K,.COMM.	;JJ2=R2
02900		FIXX(K)
03000			; JJ2 FOR RUNTHR
03100		MOVE	K,PTR-1(K)	;K=PWDS(JJ2) ← BEAM PTR.
03200		MOVE XRN(K)
03300		CAME [6.0]	; IS IT REALLY A BEAM?
03400		JRA 16,(16)	;NO - GO BACK
03500	;******* 19, ITEM# OF BEAM, STAFF# FOR RT. SIDE OF BEAM.
03600		MOVE R,XRN+5(K)
03700		SETZ MM,	; 0=BEAM STEM ↓
03800		MOVE XRN+6(K)	;RN(K+7)  STEM DIR.
03900		CAMGE [20.0]	;IS IT UP?
04000		SETO MM,	; YES    -1=BEAM STEM ↑
04100		MOVE 6,[1.0]
04200		MOVE 5,.COMM.+4		; 2ND PARAM
04300		CAMLE 5,[4.0]	;.GT.4 =0
04400		SETZ 5,
04500		MOVEM 5,ALF+5	; SAVE NOTES' STAFF #
04600		SETZ L,		; NEXT IS SEARCH LOOP
04700	H401N:	MOVE 3,PTR(L)	; 3=KWDS(L)
04800		CAME 5,XRN+1(3)	;IF RN(3).NE.STF, SKIP
04900		JRST H402N
05000		CAME 6,XRN(3)	; IS IT A NOTE?
05100		JRST H402N	; NO
05200		MOVE XRN+2(3)	;POS OF NOTE
05300		FSBR R	; NOTE POS - RT. SIDE OF BEAM
05400		MOVM		; ABS. VALUE
05500		CAMG [2.5]	; + OR - 2.5 RANGE FOR HOMING
05600		JRST H403N	; NO CLOSE ENOUGH
05700	H402N:	AOJ L,		; ADD ONE FOR LOOP
05800		CAMGE L,PTR+=250	; UP TO ITEM YET?
05900		JRST H401N
06000		JRA 16,(16)	;COULDN'T HOME IN.
06100	H403N:	MOVE L,PTR(L)	; PTR TO RIGHT NOTE
06200		MOVEI JK,XRN(L)		; (RB) PTR TO NOTE
06300		MOVE 2(JK)
06400		MOVEM ALF+=19	;SAVE PTR TO POS OF NOTE IN ALF+=19.
06500	
06600				;L=PWDS(JQ(1))  ← NOTE PTR.
06700				;RA=RN(K+3)
06800				;SAVE LOC OF RN(K+1)
06900				;RB=RN(L+3)
07000		MOVM RC,3(JK)	; RN(L+4)
07100		MOVE NX,[1.0]
07200	;;	SKIPGE RC
07300	;;	MOVNS RC
07400		CAMGE RC,[90.0]
07500		JRST .+2	;*******************
07600		MOVE NX,[0.6]	; FOR MINI NOTES AND BEAMS
07700	;;	MOVE RC,[0.7]  ;FOR MINI STEM
07800	;;	SKIPA
07900	;;	MOVE RC,[1.0]
08000	H400N:	MOVEM	JK,ALF+=20		;LOC OF RN(L+1)
08100	;N	MOVE	IZ,2(JK)   ; RB=POS OF NOTE,  RA=POS(P3) OF BEAM
08200		SETZM	ALF+=17		;N=0
08300		MOVE	0,4(JK)		;IF(RN(L+5).LT.20)N=-1
08400		CAMGE	0,[=20.0]
08500		SETOM	ALF+=17		; -1 MEANS NOTE'S STEM IS UP
08600		MOVN	0,XRN+6(K)	;RG=-(AMOD(RN(K+7),10.)-1.)[*NX]*11./7.
08700		MOVEM	0,ALF+=13		;RN(K+7)
08800		MOVEM MM,ALF+=21	;SAVE IT 'TIL AFTER AMOD
08900		JSA	16,AMOD
09000		JUMP	ALF+=13
09100		JUMP	[=10.0]
09200		FADR	0,[=1.0]
09300		FMPR	0,[=1.5714]
09400		FMPR 0,NX	; *RMINI (.6)
09500		MOVEM	0,ALF+=15		;RG SAVED IN ALF+=15
09600	;   VERTICAL SPACE FOR THE NUMB. OF BEAMS
09700		MOVE MM,ALF+=21		;GET BACK STEM DIR.
09800		MOVE	L,ALF+=20		;JT=RN(L+2) ←STAFF # OF NOTE
09900		MOVE	JT,1(L)
10000		FIXX(JT)		; JT IS IN JT
10100		MOVE	JK,XRN+1(K)	;JK=RN(K+2) ←STAFF # OF BEAM
10200		MOVEM JK,ALF+=8	; SAVE BEAM'S STAFF #
10300		FIXX(JK)		; JK IS IN JK
10400	;  THE STAFF NUMS.  JK=BEAM   JT=NOTE
10500		MOVE	IS,STF+3(JK)	;R3=RSTFAC(JK)  R3 IS IN 'IS'
10600		FMPR IS,NX	; *RMINI (.6)
10700	;;	MOVE	IZ,STF+3(JT)	;R9=RSTFAC(JT)/R3
10800		FMPR	IS,[=2.43959732]	;R8=R3*14.54/5.96
10900		MOVEM IS,ALF+=14
11000	;  R8=WIDTH OF NOTE
11100	
11200	;  ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
11300	
11400	
11500	;******* 5/74  BOTH STAVES MUST BE SAME SIZE - MOST LALF+=19ELY ********
11600		CAME	MM,ALF+=17	;3	IF(M.NE.N)GO TO 5
11700		JRST	H5N	; JUMP IF STEMS GO DIF. DIRECTIONS 
11800		SETZ	IS,		;R8=0		NOTE WIDTH
11900		SETZM ALF+=14	; ALSO NOTE WIDTH
12000		SETO MM,	;REVERSE STEM DIR. BECAUSE IT'S REVERSED LATER
12100		SKIPE ALF+=17
12200		SETZ MM,
12250		MOVEM MM,ALF+=17
12300		SETZM	ALF+=15		;RG=0	VERT SPACE FOR # OF BEAMS
12400		SETZ IZ,
12500		JRST 	H4N		;GO TO 4N
12600	H5N:	SKIPE	MM		;5	IF(M.EQ.0)GO TO 4N
12700		MOVNS	IS		;R8=-R8
12800		MOVE IZ,[13.71428571]	;=96/2  DBL STNDRD STEM LNGTH + CRAP
12900		FMPR IZ,NX	; *RMINI (.6 -- FOR MINI-NOTES)
13000	
13100	;  NOT OK IF DIFF SIZES AND RA.GT.RB ****** 5/74
13200	H4N:	FADR	IS,ALF+=19		;4	RN(K+6)=RB+R8
13300		MOVEM	IS,XRN+5(K)	;SETS CORRECT HORIZONTAL PARAM OF BEAM.
13400		MOVE	[=7.0]	; AC0=SPACE FOR ONE DIATONIC STEP(VERTICAL)
13500		FMPR   STF+3(JK)	; *STAFF SIZE FACTOR  RF=7.*R9
13600		MOVE	NN,POSI+3(JT)
13700		FSBR	NN,POSI+3(JK) ; RE=(STFF(JT)-STFF(JK))/RF
13800		FDVR  NN,0		;  DIST BETWEEN STAVES.
13900		MOVM NN,NN
14000		FSBR IZ,NN	;SUBTRAC. DBL STEM LNGTH FROM DIFF BETWEEN STAVES.
14100				;MAKE DIFF BETWEEN STAVE ALWAYS POS.
14200		FADRM IZ,ALF+=15  ;"  SPACE FOR MULTIPLE BEAMS, PUT IT IN ALF+=15
14300	;;	MOVMS ALF+=15	; ALF+=15 HAS SPACE DIFFERENCE IN VERT. NOTE SPACES.
14400		SKIPN MM
14500		MOVNS ALF+=15
14600		MOVE JK,MM
14700		CAMN MM,ALF+=17		; BOTH STEMS SAME DIR.?
14800		MOVNS ALF+=15		; YES
14900		MOVEI MM,2
15000		SKIPN JK
15100		MOVEI MM,1	; -1 BECOMES 2,  0 BECOMES 1.
15200		MOVEM MM,ALF	;REVERSES STEM DIR. FOR LATER USE. SAVES IN ALF
15300	
15400	;; IS=NOTE WIDTH,  ALF+=15 =DIST. BETWEEN STAVES, +HGT OF BEAM GROUP ETC.
15500	;; LEFT=LEFT SIDE OF BEAM, RIGHT=RIGHT SIDE
15600	
15700	
15800	
15900	;  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
16000	H197N:	MOVE PTR+=250		;197	JJ2=ITEM
16100		MOVEM POSI+=8
16200		MOVE	R,.COMM.		;R3=R2
16300		MOVEM	R,ALF+=16
16400		SETZ	K,		;DO 191 K=1,ITEM
16500		SKIPN ALF+1		; JUMP TO H191N IF DOING ORDINARY HOMING.
16600		JRST H191N
16700		MOVE K,.COMM.
16800		FIXX(K)
16900		SOJ K,		; NOW WE LOOK AT ONLY ONE BEAM (FOR DIFF. STAVES.)
17000		MOVE ALF+=8	; GET BACK STAFF #  OF BEAM
17100		MOVEM ALF+=16
17200	H191N:	MOVEM	K,ALF+=11		;SAVE K       	L=PWDS(K)
17300		MOVE	L,PTR(K)	; L IS PWDS(K+1)
17400			;IF(RN(L+1).NE.6)GO TO 191
17500		MOVEI	R,XRN(L)
17600		MOVE	A,(R)
17700		CAME	A,[=6.0]
17800		JRST	HX191N
17900		MOVE	JK,ALF+=16		;IF(RN(L+2).EQ.R3)GO TO 77
18000		CAMN	JK,1(R)
18100		JRST	H77N
18200		CAMGE	JK,[=5.0]	;IF(R3.LT.5.)GO TO 191
18300		JRST 	HX191N		; TYPE 19 99 FOR ALL STAVES
18400	H77N:	MOVE	JK,-1(R)		;77
18500		CAMN	JK,[=8.0]	;IF(RN(L).EQ.8)GO TO 191
18600		JRST	HX191N
18700		MOVE	JK,6(R)		;IF(RN(L+7).LT.10.)GO TO 191
18800		CAMGE	JK,[=10.0]	;C  FINDS BEAMS.
18900		JRST	HX191N
19000		FDVR	JK,[=10.0]	;X=RG/10.
19100		FIXX(JK)			;C  STEM DIRECT.
19200		MOVEM	JK,ALF+=19		;X SAVED IN ALF+=19
19300		MOVE	JK,1(R)		;R2=RN(L+2)
19400		MOVEM	JK,.COMM.	; USED IN 'FINDIT'
19500		MOVE	A,2(R)		;A=RN(L+3)-.01
19600		FSBR	A,[=0.01]
19700		MOVEM	A,ALF+=20		;SAVE A IN ALF+=20
19800		MOVE	JK,5(R)		;B=RN(L+6)+.01
19900		FADR	JK,[=0.01]	;C  POS 1 AND 2
20000		MOVEM	JK,ALF+=12		;B SAVED IN ALF+=12
20100		FSBR	JK,A		;DISX=B-A
20200		MOVEM	JK,ALF+=18	;DISX SAVED IN ALF+=18
20300	;  DISTANCE IN REAL STEPS
20400		MOVEM	R,ALF+7		;SAVE LOC OF RN(L+1)
20500		MOVE	0,3(R)
20600		MOVEM	0,ALF+=17
20700		JSA	16,AMOD		;RF=AMOD(RN(L+4),100.0)
20800		JUMP	ALF+=17
20900		JUMP	[=100.0]
21000		MOVEM	0,ALF+=17	; THIS IS RF!!!!
21100	;  NOTE 2
21200		MOVE	JK,ALF+7
21300		MOVE	JK,4(JK)
21400		MOVEM	JK,ALF+7
21500		JSA	16,AMOD		;RB=AMOD(RN(L+5),100.0)
21600		JUMP	ALF+7  
21700		JUMP	[=100.0]	;0 WILL HAVE RB!!!
21800		FSBR	0,ALF+=17
21900		MOVEM	0,ALF+=9		;RD SAVED IN ALF+=9  --  RD=RB-RF
22000		SKIPL ALF+1	;BEAM TO OTHER STAFF?
22100		JRST H192N-1	; NO
22200		MOVE MM,ALF	; RESETS STEM DIR FOR NOTE COMPARISON.
22300		MOVEM MM,ALF+=19
22400		MOVE ALF+5	; STAFF # FOR NOTES
22500		MOVEM .COMM.	; FOR 'FINDIT'
22600		SOJ MM,
22700		MOVE ALF+=14	; KEEP IT IN AC0 FOR A MINUTE
22800	H3:	JUMPN MM,H1	; JUMP IF STEM OF BEAM IS DOWN
22900		MOVN ALF+=14  	; SUBTR. ALF+=14 FROM RIGHT SIDE POS.
23000		FADRM ALF+=18	; ADD TO TOTAL BEAM LENGTH
23100		MOVN ALF+=14  	; SUBTR. ALF+=14 FROM RIGHT SIDE POS.
23200		FADRM ALF+=12
23300		JRST H2
23400	
23500	H1:	FADRM ALF+=12	; OPPOSITE OF ABOVE
23600		MOVE ALF+=14
23700		FADRM ALF+=18
23800	H2:	MOVE ALF+=15	; ADD TO HGT OF LEFT SIDE OF BEAM FOR STAFF DIFF.
23900		FADRM ALF+=17	; PUT IT AWAY
24000		MOVEI	NX,1
24100	;;H192N:	MOVEM	NX,DPYNEW	;	DO 192	N=1,ITEM
24200	H192N:	JSA	16,FINDIT	;IF(FINDIT(N))GO TO 192
24300		JUMP	NX
24400		JUMPL	0,HX192N
24500		MOVEI	R,XRN		;IF(RN(L).EQ.8)GO TO 192
24600		ADD	R,PTR+=251	;LOC OF RN(L+1)
24700		MOVE	JK,-1(R)
24800		CAMN	JK,[=8.0]
24900		JRST	HX192N
25000		MOVE	JK,7(R)		;IF(RN(L+8).EQ.1000.)GO TO 192
25100		CAMN	JK,[=1000.0]
25200		JRST	HX192N	; SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
25300	;  FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
25400		MOVE	A,2(R)		;RC=RN(L+3)
25500		CAMGE	A,ALF+=20		;IF(RC.LT.A)GO TO 192
25600		JRST	HX192N
25700		CAMLE	A,ALF+=12		;IF(RC.GT.B)GO TO 192
25800		JRST	HX192N	;  WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
25900		MOVE	JK,4(R)		;IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
26000		FDVR	JK,[=10.0]
26100		FIXX(JK)
26200		CAME	JK,ALF+=19
26300		JRST	HX192N
26400		FSBR	A,ALF+=20		;RC=RC-A
26500		MOVEM	A,ALF+6	;SAVES RC
26600		MOVEM	R,ALF+7		;SAVE LOC OF RN(L+1)
26700		MOVE 	0,3(R)
26800		MOVEM	0,ALF+5
26900		JSA	16,AMOD		;193	RE=AMOD(RN(L+4),100.0)
27000		JUMP	ALF+5
27100		JUMP	[=100.0]
27200		MOVEM	0,ALF+3		;RE SAVE HERE
27300		MOVE	JK,ALF+=9		;RC=RD*RC/DISX+RF
27400		FMPR	JK,ALF+6	;*RC
27500		FDVR	JK,ALF+=18	;/DISX
27600		FADR	JK,ALF+=17	;+RF
27700		MOVEM	JK,ALF+6	;RC=
27800		MOVE	JK,ALF+7
27900		MOVE	JK,6(JK)		;RG=RN(L+7)
28000		MOVEM	JK,ALF+4		;SAVE RG
28100		JSA	16,AMOD		;RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
28200		JUMP	ALF+4
28300		JUMP	[=10.0]
28400		MOVEM	0,ALF+=10
28500		JSA	16,AMOD
28600		JUMP	ALF+4
28700		JUMP	[=1.0]
28800		FSBR	0,ALF+=10
28900		FADR	0,ALF+4
29000		MOVE	L,ALF+7
29100		MOVEM	0,6(L) ;DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
29200	;  FRACTIONAL NOTE #
29300		MOVE	R,ALF+6	;195	RA=RC-RE
29400		FSBR	R,ALF+3
29500		MOVE	JK,ALF+=19		;IF(X.EQ.2)RA=-RA
29600		CAIN	JK,2
29700		MOVNS	R
29800		SKIPN	R		;IF(RA.EQ.0)RA=999.
29900		MOVE	R,[=999.0]
30000		MOVEM	R,7(L)		;196	RN(L+8)=RA
30100	;  FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
30200		CAMGE	NX,POSI+=8	;IS THIS A LOWER ITEM NUMB. (FOR 2-PASS SYS)
30300		MOVEM	NX,POSI+=8	;  SAVES # OF LOWEST ITEM FOUND
30400	HX192N:	CAMGE	NX,PTR+=250	;192	CONTINUE
30500		AOJA	NX,H192N
30600	HX191N:	MOVE	K,ALF+=11		;191	CONTINUE
30700		SKIPE ALF+1	; WERE WE LOOKING AT BEAM TO OTHER STAFF?
30800		JRST H6	; YES
30900		CAMGE	K,PTR+=250
31000		AOJA	K,H191N
31100		JRA	16,(16)		;RETURN
31200	
31300	H6:	SKIPLE ALF+1	; HAS THE FLAG BEEN CHANGED
31400		JRA 16,(16)
31500		MOVEM K,ALF+1	; PUT ANY POS NUM IN IT.
31600		MOVE ALF+=8	; GET STAFF NUM OF BEAM
31700		MOVEM .COMM.	; PUT IT BACK IN R2
31800		JRST H191N	;GO BACK TO CHECK OTHER STAFF'S STEMS.
31900		END